
program modfun
    open(form="formatted", unit=11, file="lesson2.txt")
    call example1
    call example2
    call example3
    call example4
    call example5
end

module mod1
   use precision
   private ! makes names private by default
   real(adequate),public:: x, z
   real(adequate) y
   public adequate, precise, display

   contains

   subroutine display(label)
      character(len=*),intent(in),optional:: label
	  if(present(label)) then
	     write(11, *), label
      endif
      write(11, *) x, y, z
   end subroutine display
end module mod1

subroutine example1
   use mod1
   implicit none
   integer y !does not conflict with the private y in mod1
   x = 3
   y = 2 
   call display ("example1")

end subroutine example1

module mod2
! You can't give away another module's secrets
   use mod1
   ! left out the implicit none, trouble follows...
   private

   public y ! creates a new variable y of default type real
            ! it doesn't succeed in making mod1::y public
end module mod2

subroutine example2
   use mod2
   implicit none
   ! real x does not compile, x still public
   x = 9.0
   y = 7.0
   call display("example2")
end subroutine example2

module mod3
! introducing user-defined types
   use precision
   implicit none
   public

   type atom
	  real(adequate) mass
	  integer charge
   end type atom

end module mod3

subroutine example3
   use mod3
   implicit none
   type(atom) h, he, hep
   type(atom), parameter:: omm = atom(16.0, -2)

   h = atom ( 1.0, 0)
   he = atom (omm%mass/4, 0)
   hep = he
   hep%charge = 1
   write(11, *) "h   ", h
   write(11, *) "he  ", he
   write(11, *) "hep ", hep
   call example3a
end subroutine example3

subroutine example3a
   use precision

   type curve
      real(adequate), dimension(:), pointer:: x, y
   end type curve

   real(adequate), target:: x(4) = (/ (i, i=1, 4) /)
   real(adequate), target:: y(4), z(4)
   real(adequate), pointer:: zp(:)
   type(curve) my_curve

   y = x**2
   zp => z
   zp =  y
   write(11, *) "z ", z
   my_curve = curve(x, y)
   ! due to pointer components, cannot simply write *
   write(11, *) "mycurve%x ", my_curve%x
   write(11, *) "mycurve%y ", my_curve%y
end subroutine example3a

   
module mod4
! information-hiding
   use precision
   implicit none
   public

   type atom
      private
	  real(adequate) mass
	  integer charge
   end type atom

   contains

   subroutine atom_new (a, name)
      character*(*), intent(in):: name
	  type(atom), intent(out):: a
	  select case(name)
	  case("H")
	     a = atom(1.0, 0)
	  case("He")
	     a = atom(4.0, 0)
	  case("C")
	     a = atom(12.0, 0)
	  case default
	     ! hm...
		 stop "Illegal atom creation attempted."
	  end select 
   end subroutine atom_new

   function atom_mass (a) 
      real(adequate) atom_mass
	  type(atom), intent(in):: a
	  atom_mass = a%mass
   end function atom_mass

   function atom_charge (a) 
      real(adequate) atom_charge
	  type(atom), intent(in):: a
	  atom_charge = a%charge
   end function atom_charge

   function atom_as_string (a)
      type(atom), intent(in):: a
	  character*(32) atom_as_string
	  write (atom_as_string, 100) a%mass, a%charge
100 format("atom( ", e14.4, ", ", i2, ")")
   end function atom_as_string

   subroutine set_atom_mass (a, m)
      type(atom), intent(inout):: a
	  real(adequate), intent(in):: m
	  a%mass = m
   end subroutine set_atom_mass

   subroutine set_atom_charge (a, c)
      type(atom), intent(inout):: a
	  integer, intent(in):: c
	  a%charge = c
   end subroutine set_atom_charge

end module mod4

subroutine example4
   use mod4
   type(atom) a1, a2, a3
   call atom_new(a1, "H")
   call atom_new(a2, "He")
   call atom_new(a3, "He")
   call set_atom_charge(a3, -1)
   ! write(11, *) a1 (no good, type(a) has private components)
   write(11, *) "atom_mass(a3) ", atom_mass(a3)
   write(11, *) "a3 ", trim(atom_as_string(a3))
end subroutine example4

subroutine example5
   use atoms
   use molecules
   type(atom) a1, a2, a3
   type(molecule) m1, m2, m3
   call new(a1, "H")
   call new(a2, "He")
   call new(a3, "He")
   call set_charge(a3, -1)
   call new(m1, "O2")
   call new(m2, "CH4")
   call new(m3, "H2O")
   call set_charge(m3, 0)
   write(11, *) "mass(m2) ", mass(m2)
   write(11, *) "a3 ", trim(as_string(a3))
   write(11, *) "m3 ", trim(as_string(m3))
end subroutine example5